perm filename ANI.SAI[TMP,LCS]1 blob
sn#142501 filedate 1975-01-25 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "TST"
C00006 ENDMK
C⊗;
BEGIN "TST"
REQUIRE "GEOMES.HDR[SAI,BGB]" SOURCE_FILE;
EXTERNAL SIMPLE REAL PROCEDURE ACOS(REAL X);
DEFINE SUBR="SIMPLE INTEGER PROCEDURE";
SUBR FHW(INTEGER Q);START_CODE HLRZ 1,Q;END;
SUBR LHW(INTEGER Q);START_CODE HRRZ 1,Q;END;
STRING STR;
INTEGER CI,TS,CB,FR,CHR,N,I,NF,LP;
INTEGER TF,LN,NT,TH,CA,CS;
REAL CWX,CWY,CWZ;
SAFE INTEGER ARRAY IA[1:300];
SUBR ADN;
BEGIN
OUTSTR(" NUM. OF FRAMES = ");
STR←INCHWL;
IF LENGTH(STR)=0 THEN RETURN(-1);
NF←INTSCAN(STR,CHR);CB←DAD(TS);
IF CA THEN BEGIN
IA[CA]←(IZ(CB)-IA[CA])/NF;
IA[CA+1]←XWD(N,NF);
END ELSE CS←N;
CA←N;IA[N]←IZ(CB);IA[N+1]←0;N←N+2;
CB←TS;
WHILE TS≠(CB←CW(CB)) DO BEGIN
FR←ALT2(CB);
IF (NT←PLINK(CB)) THEN BEGIN
LP←IA[NT];CWX←XWC(LP);CWY←YWC(LP);CWZ←ZWC(LP);
APTRAM(INTRAM(LP),FR);MKROTV(LP);
LN←MKTRMV(XWC(LP)/NF,YWC(LP)/NF,ZWC(LP)/NF);
BEGIN "TEX"
KLNODE(LP);
END "TEX";
XWC(LN)←(XWC(FR)-CWX)/NF;
YWC(LN)←(YWC(FR)-CWY)/NF;
ZWC(LN)←(ZWC(FR)-CWZ)/NF;
IA[NT]←LN;IA[NT+1]←XWD(N,NF);
END ELSE BEGIN
NLINK$(N,CB);IA[N]←XWD(N+1,NF);N←N+1;
END;
LP←MKCOPY(FR);IA[N]←LP;
PLINK$(N,CB);IA[N+1]←0;N←N+2;
END;
END;
SUBR MKMOVI;
BEGIN
OUTSTR(" TOTAL NUM. OF FRAMES = ");
CB←TS;I←0;STR←INCHWL;NT←IA[CS+1];CA←LHW(NT);
IF LENGTH(STR)≠0 THEN TF←INTSCAN(STR,CHR);
WHILE TS≠(CB←CW(CB)) DO BDET(CB);
WHILE (I←I+1)≤TF DO BEGIN
IF CI="M" THEN BEGIN
SHOW2(0,1);PLOTO("MOVIE."&CVS(I));CB←TS;
END ELSE GEODPY;
IF CA=0 THEN BEGIN
NT←IA[CS+1];CA←LHW(NT);CS←FHW(NT);
END;
FR←DAD(TS);IX(FR)←IX(FR)+IA[CS];CA←CA-1;
WHILE TS≠(CB←CW(CB)) DO BEGIN
TH←NLINK(CB);LN←IA[TH];NF←LHW(LN);NT←FHW(LN);
IF NF≤0 THEN BEGIN
LN←IA[NT+1];NF←LHW(LN);NT←FHW(LN);
END;
LP←IA[NT];APTRAM(CB,LP);
NF←NF-1;IA[TH]←XWD(NT,NF);
END;
END;
END;
MKUNIV;GEODPY;CI←"G";N←1;TS←DAD(UNIVERSE);
WHILE TRUE DO BEGIN
IF CI="G" THEN GEOMED;
CI←INCHRW;
IF CI="A" THEN BEGIN ADN;GEOMED;END;
IF CI="R"∨CI="M" THEN BEGIN MKMOVI;GEOMED;END;
END;
END "TST";